home *** CD-ROM | disk | FTP | other *** search
/ Aminet 52 / Aminet 52 (2002)(GTI - Schatztruhe)[!][Dec 2002].iso / Aminet / dev / gg / ncurses-5.3.lha / ncurses-5.3 / Ada95 / samples / sample.adb < prev    next >
Text File  |  2002-10-24  |  9KB  |  220 lines
  1. ------------------------------------------------------------------------------
  2. --                                                                          --
  3. --                       GNAT ncurses Binding Samples                       --
  4. --                                                                          --
  5. --                                 Sample                                   --
  6. --                                                                          --
  7. --                                 B O D Y                                  --
  8. --                                                                          --
  9. ------------------------------------------------------------------------------
  10. -- Copyright (c) 1998 Free Software Foundation, Inc.                        --
  11. --                                                                          --
  12. -- Permission is hereby granted, free of charge, to any person obtaining a  --
  13. -- copy of this software and associated documentation files (the            --
  14. -- "Software"), to deal in the Software without restriction, including      --
  15. -- without limitation the rights to use, copy, modify, merge, publish,      --
  16. -- distribute, distribute with modifications, sublicense, and/or sell       --
  17. -- copies of the Software, and to permit persons to whom the Software is    --
  18. -- furnished to do so, subject to the following conditions:                 --
  19. --                                                                          --
  20. -- The above copyright notice and this permission notice shall be included  --
  21. -- in all copies or substantial portions of the Software.                   --
  22. --                                                                          --
  23. -- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS  --
  24. -- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF               --
  25. -- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.   --
  26. -- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM,   --
  27. -- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR    --
  28. -- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR    --
  29. -- THE USE OR OTHER DEALINGS IN THE SOFTWARE.                               --
  30. --                                                                          --
  31. -- Except as contained in this notice, the name(s) of the above copyright   --
  32. -- holders shall not be used in advertising or otherwise to promote the     --
  33. -- sale, use or other dealings in this Software without prior written       --
  34. -- authorization.                                                           --
  35. ------------------------------------------------------------------------------
  36. --  Author:  Juergen Pfeifer, 1996
  37. --  Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en
  38. --  Version Control
  39. --  $Revision: 1.13 $
  40. --  Binding Version 01.00
  41. ------------------------------------------------------------------------------
  42. with Text_IO;
  43.  
  44. with Ada.Exceptions; use Ada.Exceptions;
  45.  
  46. with Terminal_Interface.Curses; use Terminal_Interface.Curses;
  47. with Terminal_Interface.Curses.Panels; use Terminal_Interface.Curses.Panels;
  48. with Terminal_Interface.Curses.Menus; use Terminal_Interface.Curses.Menus;
  49. with Terminal_Interface.Curses.Menus.Menu_User_Data;
  50. with Terminal_Interface.Curses.Menus.Item_User_Data;
  51.  
  52. with Sample.Manifest; use Sample.Manifest;
  53. with Sample.Function_Key_Setting; use Sample.Function_Key_Setting;
  54. with Sample.Keyboard_Handler; use Sample.Keyboard_Handler;
  55. with Sample.Header_Handler; use Sample.Header_Handler;
  56. with Sample.Explanation; use Sample.Explanation;
  57.  
  58. with Sample.Menu_Demo.Handler;
  59. with Sample.Curses_Demo;
  60. with Sample.Form_Demo;
  61. with Sample.Menu_Demo;
  62. with Sample.Text_IO_Demo;
  63.  
  64. with GNAT.OS_Lib;
  65.  
  66. package body Sample is
  67.  
  68.    type User_Data is
  69.       record
  70.          Data : Integer;
  71.       end record;
  72.    type User_Access is access User_Data;
  73.  
  74.    package Ud is new
  75.      Terminal_Interface.Curses.Menus.Menu_User_Data
  76.      (User_Data, User_Access);
  77.  
  78.    package Id is new
  79.      Terminal_Interface.Curses.Menus.Item_User_Data
  80.      (User_Data, User_Access);
  81.  
  82.    procedure Whow is
  83.       procedure Main_Menu;
  84.       procedure Main_Menu
  85.       is
  86.          function My_Driver (M : Menu;
  87.                              K : Key_Code;
  88.                              Pan : Panel) return Boolean;
  89.  
  90.          package Mh is new Sample.Menu_Demo.Handler (My_Driver);
  91.  
  92.          I : Item_Array_Access := new Item_Array'
  93.            (New_Item ("Curses Core Demo"),
  94.             New_Item ("Menu Demo"),
  95.             New_Item ("Form Demo"),
  96.             New_Item ("Text IO Demo"),
  97.             Null_Item);
  98.  
  99.          M : Menu := New_Menu (I);
  100.  
  101.          D1, D2 : User_Access;
  102.          I1, I2 : User_Access;
  103.  
  104.          function My_Driver (M : Menu;
  105.                              K : Key_Code;
  106.                              Pan : Panel) return Boolean
  107.          is
  108.             Idx : constant Positive := Get_Index (Current (M));
  109.          begin
  110.             if K in User_Key_Code'Range then
  111.                if K = QUIT then
  112.                   return True;
  113.                elsif K = SELECT_ITEM then
  114.                   if Idx in 1 .. 4 then
  115.                      Hide (Pan);
  116.                      Update_Panels;
  117.                   end if;
  118.                   case Idx is
  119.                      when 1 => Sample.Curses_Demo.Demo;
  120.                      when 2 => Sample.Menu_Demo.Demo;
  121.                      when 3 => Sample.Form_Demo.Demo;
  122.                      when 4 => Sample.Text_IO_Demo.Demo;
  123.                      when others => null;
  124.                   end case;
  125.                   if Idx in 1 .. 4 then
  126.                      Top (Pan);
  127.                      Show (Pan);
  128.                      Update_Panels;
  129.                      Update_Screen;
  130.                   end if;
  131.                end if;
  132.             end if;
  133.             return False;
  134.          end My_Driver;
  135.  
  136.       begin
  137.  
  138.          if (1 + Item_Count (M)) /= I'Length then
  139.             raise Constraint_Error;
  140.          end if;
  141.  
  142.          D1 := new User_Data'(Data => 4711);
  143.          Ud.Set_User_Data (M, D1);
  144.  
  145.          I1 := new User_Data'(Data => 1174);
  146.          Id.Set_User_Data (I (1), I1);
  147.  
  148.          Set_Spacing (Men => M, Row => 2);
  149.  
  150.          Default_Labels;
  151.          Notepad ("MAINPAD");
  152.  
  153.          Mh.Drive_Me (M, " Demo ");
  154.  
  155.          Ud.Get_User_Data (M, D2);
  156.          pragma Assert (D1 = D2);
  157.          pragma Assert (D1.Data = D2.Data);
  158.  
  159.          Id.Get_User_Data (I (1), I2);
  160.          pragma Assert (I1 = I2);
  161.          pragma Assert (I1.Data = I2.Data);
  162.  
  163.          Delete (M);
  164.          Free (I, True);
  165.       end Main_Menu;
  166.  
  167.    begin
  168.       Initialize (PC_Style_With_Index);
  169.       Init_Header_Handler;
  170.       Init_Screen;
  171.  
  172.       if Has_Colors then
  173.          Start_Color;
  174.  
  175.          Init_Pair (Pair => Default_Colors,  Fore => Black,   Back => White);
  176.          Init_Pair (Pair => Menu_Back_Color, Fore => Black,   Back => Cyan);
  177.          Init_Pair (Pair => Menu_Fore_Color, Fore => Red,     Back => Cyan);
  178.          Init_Pair (Pair => Menu_Grey_Color, Fore => White,   Back => Cyan);
  179.          Init_Pair (Pair => Notepad_Color,   Fore => Black,   Back => Yellow);
  180.          Init_Pair (Pair => Help_Color,      Fore => Blue,    Back => Cyan);
  181.          Init_Pair (Pair => Form_Back_Color, Fore => Black,   Back => Cyan);
  182.          Init_Pair (Pair => Form_Fore_Color, Fore => Red,     Back => Cyan);
  183.          Init_Pair (Pair => Header_Color,    Fore => Black,   Back => Green);
  184.  
  185.          Set_Background (Ch => (Color => Default_Colors,
  186.                                 Attr  => Normal_Video,
  187.                                 Ch    => ' '));
  188.          Set_Character_Attributes (Attr  => Normal_Video,
  189.                                    Color => Default_Colors);
  190.          Erase;
  191.  
  192.          Set_Soft_Label_Key_Attributes (Color => Header_Color);
  193.          --  This propagates the attributes to the label window
  194.          Clear_Soft_Label_Keys; Restore_Soft_Label_Keys;
  195.       end if;
  196.  
  197.       Init_Keyboard_Handler;
  198.  
  199.       Set_Echo_Mode (False);
  200.       Set_Raw_Mode;
  201.       Set_Meta_Mode;
  202.       Set_KeyPad_Mode;
  203.  
  204.       --  Initialize the Function Key Environment
  205.       --  We have some fixed key throughout this sample
  206.       Main_Menu;
  207.       End_Windows;
  208.  
  209.    exception
  210.       when Event : others =>
  211.          Terminal_Interface.Curses.End_Windows;
  212.          Text_IO.Put ("Exception: ");
  213.          Text_IO.Put (Exception_Name (Event));
  214.          Text_IO.New_Line;
  215.          GNAT.OS_Lib.OS_Exit (1);
  216.  
  217.    end Whow;
  218.  
  219. end Sample;
  220.